home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / psion / puzzle.opl < prev    next >
Text File  |  1995-03-31  |  5KB  |  230 lines
  1. REM puzzle.opl - 
  2. REM Copyright 1992 Stephen J Lacey 
  3. REM sj@doc.ic.ac.uk 
  4. REM 
  5. REM All standard disclaimers apply 
  6. REM I am not responsible for what this 
  7. REM program does to your machine or 
  8. REM sanity! 
  9. REM 
  10. REM History: 
  11. REM changed itos$ to num$ 
  12. REM RTFM steve :) 
  13. REM suggested by steve@maths.warwick.ac.uk 
  14. REM 
  15. REM This program is "BEERWARE" - 
  16. REM If you like this program, please 
  17. REM buy the author few pints or send him 
  18. REM the equivelent in beer tokens :-) 
  19. REM 
  20. REM Use the arrow keys or 1->4, q->r, 
  21. REM etc... to reference tiles. 
  22.  
  23. PROC puzzle: 
  24.     local inf%(32), i%, x%, y%, keyp% 
  25.     local tmp%, k$(1), k2$(1), k% 
  26.     local a$(5), h$(10) 
  27.     global fx%, fy%, free%, moves% 
  28.     global chrw%, tilewin%, tile%(16) 
  29.     global yad%, solved%, bwin%, th% 
  30.     h$ = "xr" 
  31.     th% = inf%(3) 
  32.     while (i% < 16) 
  33.         i% = i%+1 
  34.         tile%(i%) = i% 
  35.     endwh 
  36.     gInfo inf%() 
  37.     chrw% = (inf%(7)*2) + 6 
  38.     yad% = inf%(3)+4 
  39.     fx% = 3 
  40.     fy% = 3 
  41.     free% = 16 
  42.     stat: 
  43.     movep: 
  44.     drawt: 
  45.     mix: 
  46.     do 
  47.         k% = get 
  48.         if k%=$122 Rem Menu Key 
  49.             setmenu: 
  50.             k%=menu 
  51.             if k% and intf(loc(h$,chr$(k%))) 
  52.                 a$="menu"+chr$(k%) 
  53.                 @(a$): Rem Call appropriate routine 
  54.             endif 
  55.         elseif k% and $200 REM hotkey 
  56.             k%=(k%-$200) and $ffdf 
  57.             k%=loc(h$,chr$(k%)) 
  58.             if k% 
  59.                 a$="menu"+mid$(h$,k%,1) 
  60.                 @(a$): 
  61.             endif 
  62.         endif 
  63.         k2$ = chr$(k%) 
  64.         keyp% = loc("1234qwerasdfzxcv", k2$) 
  65.         if keyp% or ((k%>255) and (k%<260)) 
  66.             if keyp% : rem alpha move 
  67.                 tmp% = keyp%-1 
  68.                 y% = tmp%/4 : x% = tmp% and 3 
  69.             else : rem arrow key move 
  70.                 x% = fx% : y% = fy% 
  71.                 if k% = 256 : y% = fy%+1 
  72.                 elseif k% = 257 : y% = fy%-1 
  73.                 elseif k% = 258 : x% = fx%-1 
  74.                 else : x% = fx%+1 
  75.                 endif 
  76.                 if (x% < 0) or (y% < 0) or (x% > 3) or (y% > 3) : continue : endif 
  77.                 keyp% = (y%*4)+x%+1 
  78.             endif 
  79.             if ((x% = fx%) and (abs(y%-fy%) = 1)) or ((y% = fy%) and (abs(x%-fx%) = 1)) 
  80.                 tile%(free%) = tile%(keyp%) 
  81.                 tile%(keyp%) = 16 
  82.                 printt:(keyp%) 
  83.                 printt:(free%) 
  84.                 fx% = x% 
  85.                 fy% = y% 
  86.                 free% = keyp% 
  87.                 moves% = moves%+1 
  88.                 movep: 
  89.             endif 
  90.         endif 
  91.     until solved: 
  92. ENDP 
  93.  
  94. PROC mix: 
  95.     local i%, to% 
  96.     local px%, py%, ppx%, ppy% 
  97.     busy "Mixing tiles...", 3 
  98.     randomize month*minute*day 
  99.     while (i% < 50) 
  100.         if (int(rnd*2) = 1) 
  101.             if (fx% = 0) : fx% = 1 
  102.             elseif (fx% = 3) : fx% = 2 
  103.             else 
  104.                 if (int(rnd*2) = 0) : fx% = fx%-1 
  105.                 else : fx% = fx%+1 
  106.                 endif 
  107.             endif 
  108.         else 
  109.             if (fy% = 0) : fy% = 1 
  110.             elseif (fy% = 3) : fy% = 2 
  111.             else 
  112.                 if (int(rnd*2) = 0) : fy% = fy%-1 
  113.                 else : fy% = fy%+1 
  114.                 endif 
  115.             endif 
  116.         endif 
  117.         if (ppx% = fx%) and (ppy% = fy%) 
  118.             fx% = px% 
  119.             fy% = py% 
  120.             continue 
  121.         endif 
  122.         ppx% = px% : ppy% = py% 
  123.         px% = fx% : py% = fy% 
  124.         to% = (fy%*4)+fx%+1 
  125.         tile%(free%) = tile%(to%) 
  126.         tile%(to%) = 16 
  127.         printt:(free%) 
  128.         printt:(to%) 
  129.         free% = to% 
  130.         i% = i%+1 
  131.     endwh 
  132.     busy off 
  133. ENDP 
  134.  
  135. PROC movep: 
  136.     At 18, 8 
  137.     Print "Moves : ", moves%, "         " 
  138. ENDP 
  139.  
  140. PROC stat: 
  141.     local w%, s% 
  142.     s% = (chrw%*4)+20 
  143.     gUse 1 
  144.     gStyle 9 
  145.     w% = GTwidth("Puzzle!") 
  146.     gAT s%, 30 : gPrint "Puzzle!" 
  147.     gStyle 0 
  148.     gAt s%+w%+4, 30 : gPrint "by Steevie" 
  149.     gAt s%, 40 : gPrint "<sjl@doc.ic.ac.uk>" 
  150. ENDP 
  151.  
  152. PROC solved: 
  153.     local i%, c% 
  154.     while (i% < 16) 
  155.         i% = i%+1 
  156.         if (tile%(i%) <> i%) 
  157.             return 0 
  158.         endif 
  159.     endwh 
  160.     c%=1 
  161.     dInit "You've solved the puzzle!" 
  162.     dChoice c%, "Try again?", "Yes,No" 
  163.     if dialog and (c%=1) 
  164.         mix: 
  165.         moves% = 0 
  166.         movep: 
  167.         return 0 
  168.     else  
  169.         return 1 
  170.     endif 
  171. ENDP 
  172.  
  173. PROC drawt: 
  174.     local s%, i% 
  175.     s% = chrw%*4 
  176.     bwin% = gCreate(0, 0, s%+8, s%+8, 1) 
  177.     gBorder $201 
  178.     tilewin% = gCreate(4, 4, s%, s%, 1) 
  179.     gUse tilewin% 
  180.     gUpdate off 
  181.     while (i% < 15) 
  182.         i% = i%+1 
  183.         printt:(i%) 
  184.     endwh 
  185.     gUpdate on 
  186. ENDP 
  187.  
  188. PROC printt:(i%) 
  189.     local j%, y%, x%, s$(2), s% 
  190.     s%=chrw%*4 
  191.     y% = ((i%-1)/4) * chrw% : x% = ((i%-1) and 3) * chrw% 
  192.     if (tile%(i%) = 16) 
  193.         gAt x%, y% : gFill chrw%, chrw%, 1 
  194.         return 
  195.     endif 
  196.     j% = i% 
  197.     s$ = num$(tile%(i%), 2) 
  198.     gAt x%, y% : gBox chrw%, chrw% 
  199.     gAt x% + ((chrw% - gTwidth(s$))/2), y% + yad% 
  200.     gPrint s$ 
  201. ENDP 
  202.  
  203. PROC setmenu: 
  204.     mInit  
  205.     mCard "Options","Restart",%R,"Exit",%X 
  206. ENDP 
  207.  
  208. PROC menux: 
  209.     local c% 
  210.     c%=1 
  211.     dInit "Really exit?" 
  212.     dChoice c%, "Well??", "Yes,No" 
  213.     if dialog and (c%=1) 
  214.         stop 
  215.     endif 
  216. ENDP 
  217.  
  218. PROC menur: 
  219.     local c% 
  220.     c%=1 
  221.     dInit "Are you sure?" 
  222.     dChoice c%, "Well??", "Yes,No" 
  223.     if dialog and (c%=1) 
  224.         mix: 
  225.         moves% = 0 
  226.         movep: 
  227.     endif 
  228. ENDP 
  229.  
  230.